home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic 4 Database How-To
/
Visual Basic 4 Database - How-to (The Waite Group)(1995).iso
/
tablist.fr_
/
tablist.fr
Wrap
Text File
|
1994-12-27
|
5KB
|
176 lines
VERSION 4.00
Begin VB.Form frmTableList
BackColor = &H00C0C0C0&
BorderStyle = 3 'Fixed Double
Caption = "Current Tables"
ClientHeight = 4275
ClientLeft = 1605
ClientTop = 1560
ClientWidth = 3735
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 8.25
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 4680
Left = 1545
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4275
ScaleWidth = 3735
Top = 1215
Width = 3855
Begin VB.CommandButton cmdDelete
Caption = "&Delete"
Height = 615
Left = 300
TabIndex = 2
Top = 3120
Width = 1275
End
Begin VB.CommandButton cmdClose
Cancel = -1 'True
Caption = "Close"
Default = -1 'True
Height = 615
Left = 1980
TabIndex = 1
Top = 3120
Width = 1275
End
Begin VB.ListBox lstTables
Height = 2175
Left = 540
Sorted = -1 'True
TabIndex = 0
Top = 420
Width = 2595
End
End
Attribute VB_Name = "frmTableList"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
' Modify the path to point to your copy of BIBLIO.MDB.
Const DATABASE_NAME = "D:\VB4\BIBLIO.MDB"
Private Sub Form_Load()
' Fill the list box with the current non-system tables in DATABASE_NAME.
ListTables
End Sub
Private Sub ListTables()
Dim db As Database
Dim td As TableDef
On Error GoTo ListError
Screen.MousePointer = 11
lstTables.Clear
Set db = DBEngine.Workspaces(0).OpenDatabase(DATABASE_NAME)
' Cycle through the table definitions in DATABASE_NAME.
' If the table is a system table (name begins with MSys), ignore it.
' Otherwise, add it to the list.
For Each td In db.TableDefs
If Left$(td.Name, 4) <> "MSys" Then lstTables.AddItem td.Name
Next
Screen.MousePointer = 0
Exit Sub
ListError:
Screen.MousePointer = 0
MsgBox Error$, vbExclamation
Unload frmTableList
Exit Sub
End Sub
Private Sub cmdDelete_Click()
Dim db As Database
on error goto DeleteError
Screen.MousePointer = 11
' If the user has selected a table, proceed.
If lstTables.ListIndex > -1 Then
' If the table has no records, proceed.
If TableIsEmpty() Then
' Delete the selected table from DATABASE_NAME.
Set db = DBEngine.Workspaces(0).OpenDatabase(DATABASE_NAME)
db.Execute ("DROP TABLE [" & lstTables.Text & "]")
' Display the modified list of tables.
ListTables
Else
' The table has records, so inform the user.
Screen.MousePointer = 11
MsgBox lstTables.Text & " is not empty.", vbExclamation
End If
Screen.MousePointer = 0
Else
Screen.MousePointer = 0
MsgBox "You have not selected a table to delete.", vbExclamation
End If
Exit Sub
DeleteError:
Screen.MousePointer = 0
MsgBox Error$
Unload frmTableList
Exit Sub
End Sub
Function TableIsEmpty() As Boolean
Dim db As Database
Dim td As TableDef
On Error Goto TableIsEmptyError
Set db = DBEngine.Workspaces(0).OpenDatabase(DATABASE_NAME)
' Cycle through the table definitions in DATABASE_NAME.
' When the table currently selected in lstTables is found, check to
' see whether it has records. If it does not, return True; otherwise,
' return False.
For Each td In db.TableDefs
If td.Name = lstTables.Text Then
TableIsEmpty = IIf(td.RecordCount = 0, True, False)
Exit For
End If
Next
Exit Function
TableIsEmptyError:
MsgBox Error$
Unload frmTableList
Exit Function
End Function
Private Sub cmdClose_Click()
Unload frmTableList
End Sub